Download der XML Dateien und konvertieren zu SHP
get_xml <- function(years) {
p <- progress_estimated(length(years))
purrr::map(years, function(year) {
base_url <- sprintf("http://fbinter.stadt-berlin.de/fb/wfs/geometry/senstadt/re_brw%s", year)
url <- paste0(base_url, "?REQUEST=GetFeature&SERVICE=WFS&VERSION=2.0.0&TYPENAMES=GML2")
fname <- sprintf("./data/brw%s.xml", year)
result <- httr::GET(url, httr::write_disk(path = fname, overwrite = TRUE))
#if (result$status_code > 201) {
# stop(result$status_code, ": downloading file; file may not exist", call. = FALSE)
#}
dest_file <- sprintf("./data/brw%s.shp", year)
ogr2ogr(src_datasource_name = fname,
dst_datasource_name = dest_file,
f = "ESRI Shapefile",
s_srs = "EPSG:25833",
t_srs = "WGS84",
overwrite = TRUE)
Sys.sleep(.5)
p$tick()$print()
})
}
read_brw <- function() {
files <- dir("./data/", pattern = ".shp", full.names = TRUE)
purrr::map(files, function(file) {
# see https://github.com/edzer/sfr/issues/5
st_read(file,
quiet = TRUE,
stringsAsFactors = FALSE,
options = "ENCODING=UTF-8") %>%
select(spatial_al, spatial_ty, BEZIRK, BRW,
NUTZUNG, STICHTAG, GFZ, BEITRAGSZU, geometry) %>%
mutate(BRW = as.integer(BRW),
year = as.numeric(format(as.Date(STICHTAG), "%Y")))
}) -> out
}
microbenchmark::microbenchmark(get_xml(2002:2017), times = 1L)
Import der Shapefiles
dat <- read_brw()
# dat %>%
# bind_rows()
# Error in .subset2(x, i, exact = exact) :
# attempt to select less than one element in get1index
dat <- do.call("rbind", dat)
class(dat)
## [1] "sf" "data.frame"
glimpse(dat, width = 110)
## Observations: 17,360
## Variables: 10
## $ spatial_al <dbl> 1000, 1001, 1002, 1003, 1004, 1005, 1006, 1007, 1008, 1009, 1010, 1011, 1012, 1013, 10...
## $ spatial_ty <chr> "Polygon", "Polygon", "Polygon", "Polygon", "Polygon", "Polygon", "Polygon", "Polygon"...
## $ BEZIRK <chr> "Marzahn-Hellersdorf", "Treptow-Köpenick", "Spandau", "Marzahn-Hellersdorf", "Mitte", ...
## $ BRW <int> 160, 180, 220, 85, 1700, 490, 55, 460, 2000, 640, 160, 160, 1000, 70, 220, 690, 70, 85...
## $ NUTZUNG <chr> "G - Gewerbe", "W - Wohngebiet", "W - Wohngebiet", "Gp - Gewerbe produzierend", "M1 - ...
## $ STICHTAG <chr> "2002-01-01T00:00:00", "2002-01-01T00:00:00", "2002-01-01T00:00:00", "2002-01-01T00:00...
## $ GFZ <dbl> NA, 0.7, 0.7, NA, 4.5, 0.6, NA, 1.5, 4.5, 2.5, 0.4, NA, 2.5, NA, 0.8, 2.5, NA, NA, 0.4...
## $ BEITRAGSZU <chr> "Beitragsfrei nach BauGB", "Beitragsfrei nach BauGB", "Beitragsfrei nach BauGB", "Beit...
## $ year <dbl> 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 20...
## $ geometry <simple_feature> MULTIPOLYGON(((13.558663970..., MULTIPOLYGON(((13.531149513..., MULTIPOLYGO...
head(dat, 2) %>% knitr::kable()
| 1000 |
Polygon |
Marzahn-Hellersdorf |
160 |
G - Gewerbe |
2002-01-01T00:00:00 |
NA |
Beitragsfrei nach BauGB |
2002 |
13.55866, 13.55824, 13.55434, 13.55252, 13.55239, 13.55232, 13.55224, 13.55216, 13.55214, 13.55214, 13.55229, 13.55258, 13.55542, 13.55568, 13.55279, 13.55247, 13.55174, 13.55158, 13.55039, 13.55088, 13.55135, 13.55556, 13.55563, 13.55847, 13.56161, 13.56263, 13.56376, 13.56374, 13.56366, 13.56416, 13.56413, 13.56666, 13.56666, 13.56758, 13.56768, 13.56528, 13.56455, 13.56335, 13.56410, 13.55904, 13.55929, 13.55911, 13.55866, 52.50378, 52.50349, 52.50180, 52.50342, 52.50354, 52.50365, 52.50381, 52.50397, 52.50412, 52.50424, 52.50576, 52.50575, 52.50569, 52.50748, 52.50760, 52.50761, 52.50763, 52.50763, 52.50784, 52.50851, 52.50937, 52.50908, 52.50907, 52.50889, 52.50875, 52.51291, 52.51290, 52.51272, 52.51182, 52.51182, 52.51153, 52.51145, 52.51096, 52.51034, 52.51025, 52.50854, 52.50891, 52.50800, 52.50769, 52.50428, 52.50411, 52.50401, 52.50378 |
| 1001 |
Polygon |
Treptow-Köpenick |
180 |
W - Wohngebiet |
2002-01-01T00:00:00 |
0.7 |
Beitragsfrei nach BauGB |
2002 |
13.53115, 13.53069, 13.53024, 13.53005, 13.52737, 13.52482, 13.52323, 13.52160, 13.52001, 13.51814, 13.51596, 13.51472, 13.51655, 13.51729, 13.51804, 13.51916, 13.52004, 13.52074, 13.52137, 13.52223, 13.52310, 13.52366, 13.52399, 13.52848, 13.52897, 13.53005, 13.53182, 13.53131, 13.53316, 13.53487, 13.53571, 13.53666, 13.53871, 13.53911, 13.54167, 13.54239, 13.54385, 13.54531, 13.54367, 13.54560, 13.54523, 13.54281, 13.54052, 13.53722, 13.53439, 13.53289, 13.53069, 13.53119, 13.53135, 13.53115, 52.44824, 52.44831, 52.44840, 52.44814, 52.44871, 52.44921, 52.44945, 52.44955, 52.44962, 52.45081, 52.45213, 52.45298, 52.45279, 52.45248, 52.45239, 52.45170, 52.45117, 52.45160, 52.45123, 52.45172, 52.45154, 52.45244, 52.45239, 52.45145, 52.45219, 52.45217, 52.45212, 52.45298, 52.45338, 52.45396, 52.45257, 52.45269, 52.45335, 52.45261, 52.45309, 52.45318, 52.45328, 52.45315, 52.45042, 52.44999, 52.44938, 52.44988, 52.45036, 52.45104, 52.45175, 52.45148, 52.45107, 52.45000, 52.44912, 52.44824 |
Zuordnung der Wohnlage im Jahr 2017
wl_gr <- c("M", "E", "G", "E/M", "M/E", "G/M", "G/E", "M/G", "E/G")
match_WL <- function(x, y) {
z <- sum(match(c(x,y), wl_gr), na.rm = TRUE)
z <- ifelse(z == 0, NA, z)
z }
wl <- readr::read_tsv("tabula-brw-liste-geschlossene-bauweise-2017.tsv",
col_names = FALSE, skip= 1) %>%
select(X1, X6, X7) %>%
filter(!is.na(X1), X1 != "GFZ") %>%
purrr::set_names(c("spatial_al", "WL_A", "WL_B")) %>%
mutate(spatial_al = as.numeric(spatial_al)) %>%
rowwise() %>%
mutate(Wohnlage = match_WL(WL_A, WL_B),
Wohnlage = wl_gr[Wohnlage]) %>%
select(spatial_al, Wohnlage) %>%
arrange(spatial_al)
## Parsed with column specification:
## cols(
## X1 = col_character(),
## X2 = col_character(),
## X3 = col_character(),
## X4 = col_character(),
## X5 = col_character(),
## X6 = col_character(),
## X7 = col_character(),
## X8 = col_character(),
## X9 = col_character(),
## X10 = col_character(),
## X11 = col_character(),
## X12 = col_character(),
## X13 = col_character(),
## X14 = col_character()
## )
## Warning: 243 parsing failures.
## row col expected actual file
## 15 -- 14 columns 13 columns 'tabula-brw-liste-geschlossene-bauweise-2017.tsv'
## 16 -- 14 columns 13 columns 'tabula-brw-liste-geschlossene-bauweise-2017.tsv'
## 17 -- 14 columns 13 columns 'tabula-brw-liste-geschlossene-bauweise-2017.tsv'
## 18 -- 14 columns 13 columns 'tabula-brw-liste-geschlossene-bauweise-2017.tsv'
## 19 -- 14 columns 13 columns 'tabula-brw-liste-geschlossene-bauweise-2017.tsv'
## ... ... .......... .......... .................................................
## See problems(...) for more details.
dat <- left_join(dat, wl, by="spatial_al")
table(dat$GFZ, dat$Wohnlage) %>% knitr::kable()
| 0.1 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 0.2 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 0.3 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 0.4 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 0.5 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 0.6 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 0.7 |
23 |
0 |
0 |
0 |
0 |
0 |
89 |
0 |
0 |
| 0.8 |
72 |
16 |
26 |
86 |
0 |
16 |
131 |
15 |
0 |
| 0.9 |
16 |
0 |
9 |
0 |
0 |
0 |
0 |
0 |
0 |
| 1 |
272 |
0 |
96 |
191 |
16 |
59 |
490 |
117 |
0 |
| 1.2 |
32 |
0 |
7 |
63 |
0 |
16 |
146 |
58 |
0 |
| 1.3 |
16 |
0 |
7 |
16 |
0 |
0 |
55 |
0 |
0 |
| 1.5 |
46 |
0 |
64 |
16 |
0 |
0 |
192 |
72 |
16 |
| 1.6 |
0 |
0 |
0 |
0 |
0 |
0 |
16 |
0 |
0 |
| 1.7 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 1.8 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 2 |
175 |
0 |
48 |
48 |
0 |
33 |
136 |
22 |
11 |
| 2.4 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 2.5 |
208 |
0 |
47 |
16 |
0 |
0 |
42 |
25 |
15 |
| 2.7 |
14 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 3 |
16 |
0 |
0 |
0 |
0 |
0 |
16 |
0 |
0 |
| 3.5 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 4 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
| 4.5 |
0 |
0 |
0 |
0 |
0 |
0 |
16 |
0 |
0 |
saveRDS(dat, file = "brw_data.rds")
Karte der Bodenrichtwerte im Jahr 2017 - BRW <= 8.000
brw <- st_read("./data/brw2017.shp",
quiet = TRUE,
stringsAsFactors = FALSE,
options = "ENCODING=UTF-8") %>%
filter(BRW <= 8000)
pal <- colorNumeric(
palette = viridis_pal()(10),
domain = brw$BRW
)
popup <- paste0("<b>", brw$spatial_al, " - ",
brw$NUTZUNG , " - ",
brw$GFZ, " - ",
brw$BRW, " Euro/qm")
leafMap <- leaflet(height = "800px", width = "1000px") %>%
setView(lng = 13.383, lat = 52.516, zoom = 11) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addPolygons(data = brw,
stroke = TRUE,
dashArray = 1,
weight = 1.5,
color = "white",
smoothFactor = 0.20,
fillOpacity = 0.60,
fillColor = ~pal(brw$BRW),
highlightOptions = highlightOptions(color = "steelblue",
weight = 4,
bringToFront = FALSE),
popup = popup,
group = "Bodenrichtwerte") %>%
addLegend("bottomright",
pal = pal,
values = brw$BRW,
title = "Euro/qm",
labFormat = labelFormat(suffix = " "),
opacity = 1)
leafMap
Session Info
## Session info -------------------------------------------------------------------------------------------------------------------------------
## setting value
## version R version 3.3.3 Patched (2017-03-06 r72330)
## system x86_64, mingw32
## ui RTerm
## language (EN)
## collate German_Germany.1252
## tz Europe/Berlin
## date 2017-04-08
## Packages -----------------------------------------------------------------------------------------------------------------------------------
## package * version date source
## assertthat 0.1 2013-12-06 CRAN (R 3.3.3)
## backports 1.0.5 2017-01-18 CRAN (R 3.3.2)
## codetools 0.2-15 2016-10-05 CRAN (R 3.3.3)
## colorspace 1.3-2 2016-12-14 CRAN (R 3.3.3)
## crosstalk 1.0.0 2016-12-21 CRAN (R 3.3.3)
## DBI 0.6-1 2017-04-01 CRAN (R 3.3.3)
## devtools 1.12.0 2016-06-24 CRAN (R 3.3.3)
## digest 0.6.12 2017-01-27 CRAN (R 3.3.3)
## dplyr * 0.5.0 2016-06-24 CRAN (R 3.3.3)
## evaluate 0.10 2016-10-11 CRAN (R 3.3.3)
## foreach 1.4.3 2015-10-13 CRAN (R 3.3.3)
## gdalUtils * 2.0.1.7 2015-10-10 CRAN (R 3.3.3)
## ggplot2 * 2.2.1.9000 2017-03-28 Github (tidyverse/ggplot2@f4398b6)
## gridExtra 2.2.1 2016-02-29 CRAN (R 3.3.3)
## gtable 0.2.0 2016-02-26 CRAN (R 3.3.3)
## highr 0.6 2016-05-09 CRAN (R 3.3.3)
## hms 0.3 2016-11-22 CRAN (R 3.3.3)
## htmltools 0.3.5 2016-03-21 CRAN (R 3.3.3)
## htmlwidgets 0.8 2017-03-14 Github (ramnathv/htmlwidgets@3ce9f90)
## httpuv 1.3.3 2015-08-04 CRAN (R 3.3.3)
## iterators 1.0.8 2015-10-13 CRAN (R 3.3.2)
## jsonlite 1.3 2017-02-28 CRAN (R 3.3.3)
## knitr 1.15.19 2017-04-08 Github (yihui/knitr@6f166e2)
## labeling 0.3 2014-08-23 CRAN (R 3.3.2)
## lattice 0.20-35 2017-03-25 CRAN (R 3.3.3)
## lazyeval 0.2.0 2016-06-12 CRAN (R 3.3.3)
## leaflet * 1.1.0.9000 2017-04-07 Github (rstudio/leaflet@00bb41c)
## magrittr 1.5 2014-11-22 CRAN (R 3.3.3)
## memoise 1.0.0 2016-01-29 CRAN (R 3.3.3)
## mime 0.5 2016-07-07 CRAN (R 3.3.2)
## munsell 0.4.3 2016-02-13 CRAN (R 3.3.3)
## plyr 1.8.4 2016-06-08 CRAN (R 3.3.3)
## purrr 0.2.2 2016-06-18 CRAN (R 3.3.3)
## R.methodsS3 1.7.1 2016-02-16 CRAN (R 3.3.2)
## R.oo 1.21.0 2016-11-01 CRAN (R 3.3.2)
## R.utils 2.5.0 2016-11-07 CRAN (R 3.3.3)
## R6 2.2.0 2016-10-05 CRAN (R 3.3.3)
## raster 2.5-8 2016-06-02 CRAN (R 3.3.3)
## Rcpp 0.12.10 2017-03-31 Github (RcppCore/Rcpp@886f5df)
## readr 1.1.0 2017-03-31 Github (hadley/readr@0c33609)
## reshape2 1.4.2 2016-10-22 CRAN (R 3.3.3)
## rgdal 1.2-6 2017-04-06 CRAN (R 3.3.3)
## rmarkdown 1.4.0.9001 2017-04-05 Github (rstudio/rmarkdown@b7434dc)
## rprojroot 1.2 2017-01-16 CRAN (R 3.3.3)
## scales * 0.4.1 2016-11-09 CRAN (R 3.3.3)
## sf * 0.4-2 2017-04-08 Github (edzer/sfr@5eb1f92)
## shiny 1.0.1 2017-04-01 CRAN (R 3.3.3)
## sp 1.2-4 2016-12-22 CRAN (R 3.3.3)
## stringi 1.1.3 2017-03-21 CRAN (R 3.3.3)
## stringr 1.2.0 2017-02-18 CRAN (R 3.3.3)
## tibble * 1.3.0 2017-04-03 Github (tidyverse/tibble@797d711)
## udunits2 0.13 2016-11-17 CRAN (R 3.3.2)
## units 0.4-3 2017-03-25 CRAN (R 3.3.3)
## viridis * 0.4.0 2017-03-28 Github (sjmgarnier/viridis@cb9a6b9)
## viridisLite * 0.2.0 2017-03-28 Github (sjmgarnier/viridisLite@911015c)
## withr 1.0.2 2016-06-20 CRAN (R 3.3.3)
## xtable 1.8-2 2016-02-05 CRAN (R 3.3.3)
## yaml 2.1.14 2016-11-12 CRAN (R 3.3.3)